(use math.const)
(use math.mt-random)
(use srfi-1)
(use srfi-11)
(use gauche.parameter)
(use sdl)
(use goshsdlrot)

(sdl-init (logand SDL_INIT_VIDEO SDL_INIT_TIMER))
(define-constant screen-width 640)
(define-constant screen-height 480)
(define screen (sdl-set-video-mode screen-width screen-height 16 0))
(define bgcolor (sdl-map-rgb (sdl-surface-pixel-format screen) 0 0 0))
(define player #f)
(define enemy-list '())
(define bullet-list '())
(define meteorite-list '())
(define particle-list '())
(define simkeys #f)
(define quit-loop #f)
(define-constant wall 10000)
(define-constant shooter-player 0)
(define-constant shooter-enemy 1)
(define mtwister (make <mersenne-twister> :seed (sys-time)))

(define-class <coord> ()
  ((x :init-value 0 :init-keyword :x :accessor x-of)
   (y :init-value 0 :init-keyword :y :accessor y-of)
   (screen-x :accessor screen-x-of :allocation :virtual
	     :slot-ref
	     (lambda (o)
	       (+ (/ screen-width 2) (- (ref o 'x) (x-of (coord-of player)))))
	     :slot-set!
	     (lambda (o v)
	       (set! (ref o 'x) (- v (/ screen-width 2)))))
   (screen-y :accessor screen-y-of :allocation :virtual
	     :slot-ref
	     (lambda (o)
	       (- (/ screen-height 2) (- (ref o 'y) (y-of (coord-of player)))))
	     :slot-set!
	     (lambda (o v)
	       (set! (ref o 'y) (- (/ screen-height 2) v))))))

(define (make-rectangular-from-coord c)
  (make-rectangular (x-of c) (y-of c)))

(define (set!-coord c0 c1)
  (set! (x-of c0) (x-of c1))
  (set! (y-of c0) (y-of c1)))

(define (inc!-coord c0 c1)
  (inc! (x-of c0) (x-of c1))
  (inc! (y-of c0) (y-of c1)))

(define (make-coord-polar magnitude degree)
  (let ((z (make-polar magnitude (* pi/180 degree))))
    (make <coord> :x (real-part z) :y (imag-part z))))

(define (wall-warp! c)
  (if (< (x-of c) (- wall)) (set! (x-of c) wall))
  (if (< (y-of c) (- wall)) (set! (y-of c) wall))
  (if (> (x-of c) wall) (set! (x-of c) (- wall)))
  (if (> (y-of c) wall) (set! (y-of c) (- wall))))

(define (random-range min max)
  (+ (mt-random-integer mtwister (- max min)) min))

(define (random-coord range)
  (make <coord> :x (random-range (- range) range) :y (random-range (- range) range)))

(define (close-to? c0 c1 range)
  (and
   (< (abs (- (x-of c0) (x-of c1))) range)
   (< (abs (- (y-of c0) (y-of c1))) range)))

(define-class <basic-object> ()
  ((coord :init-form (make <coord>) :accessor coord-of)
   (vvect :init-form (make <coord>) :accessor vvect-of)
   (angle :init-value 0 :init-keyword :angle :accessor angle-of)))

(define-class <player> (<basic-object>)
  ((surface :init-value #f :init-keyword :surface :accessor surface-of :allocation :class)
   (fire-interval :init-value 0 :init-keyword :fire-interval :accessor fire-interval-of)))

(define-class <enemy> (<player>)
  ((surface :init-value #f :init-keyword :surface :accessor surface-of :allocation :class)
   (life :init-value 2 :init-keyword :life :accessor life-of)))

(define-method broken? ((ene <enemy>))
  (negative? (life-of ene)))

(define-method fire ((pl <player>))
  (if (zero? (fire-interval-of pl))
      (let1 bul (make <bullet>)
	(if (eq? pl player)
	    (set! (fire-interval-of pl) 3)
	    (set! (fire-interval-of pl) 10))
	(set!-coord (coord-of bul) (coord-of pl))
	(set! (angle-of bul) (angle-of pl))
	(if (eq? pl player)
	    (set!-coord (vvect-of bul) (make-coord-polar 15 (angle-of bul)))
	    (set!-coord (vvect-of bul) (make-coord-polar 10 (angle-of bul))))
	(inc!-coord (vvect-of bul) (vvect-of pl))
	(if (eq? pl player)
	    (set! (shooter-of bul) shooter-player)
	    (set! (shooter-of bul) shooter-enemy))
	(set! bullet-list (cons bul bullet-list)))))

(define-method rotate ((pl <player>) n)
  (let1 angle (angle-of pl)
    (inc! angle n)
    (set! (angle-of pl) (modulo (x->integer angle) 360))))

(define-method accel ((pl <player>))
  (inc!-coord (vvect-of pl) (make-coord-polar 1 (angle-of pl)))
  (set! (x-of (vvect-of pl)) (clamp (x-of (vvect-of pl)) -20 20))
  (set! (y-of (vvect-of pl)) (clamp (y-of (vvect-of pl)) -20 20))
  (let loop ((i 5))
    (if (= i 0)
	#t
	(begin
	  (let1 part (make <particle>)
	    (set!-coord (coord-of part) (coord-of pl))
	    (inc!-coord (coord-of part) (random-coord 7))
	    (set! (angle-of part) (+ (angle-of pl) (random-range 130 230)))
	    (set!-coord (vvect-of part) (make-coord-polar 5 (angle-of part)))
	    (set! particle-list (cons part particle-list)))
	  (loop (- i 1))))))

(define-method deccel ((pl <player>))
  (define (multiplied-normalized-coord c m)
    (let1 z (make-rectangular-from-coord c)
      (let1 z0 (* m (/ z (magnitude z)))
	(make <coord> :x (real-part z0) :y (imag-part z0)))))
  (inc!-coord (vvect-of pl) (multiplied-normalized-coord (vvect-of pl) -2))
  (let loop ((i 5))
    (if (= i 0)
	#t
	(begin
	  (let1 part (make <particle>)
	    (set!-coord (coord-of part) (coord-of pl))
	    (inc!-coord (coord-of part) (random-coord 4))
	    (set! (angle-of part) (+ (angle-of pl) (random-range 0 360)))
	    (set!-coord (vvect-of part) (make-coord-polar 5 (angle-of part)))
	    (set! (lifetime-of part) 5)
	    (set! particle-list (cons part particle-list)))
	  (loop (- i 1))))))

(define-method ai ((ene <enemy>))
  (define (angle-to-target src tar)
    (let ((z-src (make-rectangular-from-coord src))
	  (z-tar (make-rectangular-from-coord tar)))
      (x->integer (* 180/pi (angle (- z-tar z-src))))))
  (let1 diff-angle (modulo (- (angle-of ene) (angle-to-target (coord-of ene) (coord-of player))) 360)
    (cond
     ((negative? (- 180 diff-angle)) (rotate ene (min 10 diff-angle)))
     ((positive? (- 180 diff-angle)) (rotate ene (- (min 10 diff-angle)))))
    (if (or 
	 (< diff-angle 30)
	 (> diff-angle 330))
	(begin 
	  (accel ene)
	  (if (close-to? (coord-of ene) (coord-of player) 200)
	      (fire ene))))
    (if (and 
	 (> diff-angle 150)
	 (< diff-angle 210))
	(deccel ene))))

(define-method break ((ene <enemy>))
  (dec! (life-of ene)))

(define-class <bullet> (<basic-object>)
  ((surface :init-value #f :init-keyword :surface :accessor surface-of :allocation :class)
   (lifetime :init-value 100 :init-keyword :lifetime :accessor lifetime-of)
   (shooter :init-value shooter-player :init-keyword :shooter :accessor shooter-of)))

(define-class <meteorite> (<basic-object>)
  ((greatness :init-value 0 :accessor greatness-of)
   (surface :accessor surface-of :allocation :virtual
	    :slot-ref
	     (lambda (o)
	       (list-ref (ref o 'surface-list) (ref o 'greatness))))
   (surface-list :init-value '() :init-keyword :surface-list :accessor surface-list-of :allocation :class)))

(define-method broken? ((met <meteorite>))
  (> (greatness-of met) 3))

(define-method break ((met <meteorite>))
  (inc! (greatness-of met))
  (if (broken? met)
      #t
      (let1 met-child (make <meteorite>)
	(set! (greatness-of met-child) (greatness-of met))
	(set!-coord (coord-of met-child) (coord-of met))
	(set!-coord (vvect-of met) (make-coord-polar (random-range 4 8) (+ (angle-of player) 90)))
	(set!-coord (vvect-of met-child) (make-coord-polar (random-range 4 8) (- (angle-of player) 90)))
	(set! meteorite-list (cons met-child meteorite-list)))))

(define-class <particle> (<basic-object>)
  ((lifetime :init-value 6 :init-keyword :lifetime :accessor lifetime-of)
   (surface :init-value #f :init-keyword :surface :accessor surface-of :allocation :class)))

(define-class <simkey> ()
  ((pressing :init-value #f :init-keyword :pressing :accessor pressing-of)))

(define-method press ((key <simkey>))
  (set! (pressing-of key) #t))

(define-method release ((key <simkey>))
  (set! (pressing-of key) #f))

(define-class <simkeys> ()
  ((space :init-form (make <simkey>) :accessor space-of)
   (up :init-form (make <simkey>) :accessor up-of)
   (down :init-form (make <simkey>) :accessor down-of)
   (left :init-form (make <simkey>) :accessor left-of)
   (right :init-form (make <simkey>) :accessor right-of)))
	
(define (show surf c)
  (define (screen-x-of-with-surface c surf)
    (- (screen-x-of c) (/ (sdl-surface-w surf) 2)))
  (define (screen-y-of-with-surface c surf)
    (- (screen-y-of c) (/ (sdl-surface-h surf) 2)))
  (let ((x (x->integer (screen-x-of-with-surface c surf)))
	(y (x->integer (screen-y-of-with-surface c surf)))
	(w (sdl-surface-w surf))
	(h (sdl-surface-h surf)))
    (if (and
	 (> x (- w))
	 (> y (- h))
	 (< x screen-width)
	 (< y screen-height))
	(sdl-blit-surface surf #f screen (sdl-make-rect x y w h)))))

(define (key-event)
  (let key-event-loop ((e (sdl-make-event)))
    (let1 count (sdl-poll-event e)
      (if (> count 0)
	  (begin
	    (cond
	     ((= SDL_KEYDOWN (sdl-event-type e))
	      (let1 keysym (sdl-event-key-keysym-sym e)
		(cond
		 ((= keysym SDLK_SPACE)
		  (press (space-of simkeys)))
		 ((= keysym SDLK_LEFT)
		  (press (left-of simkeys)))
		 ((= keysym SDLK_RIGHT)
		  (press (right-of simkeys)))
		 ((= keysym SDLK_UP)
		  (press (up-of simkeys)))
		 ((= keysym SDLK_DOWN)
		  (press (down-of simkeys))))))
	     ((= SDL_KEYUP (sdl-event-type e))
	      (let1 keysym (sdl-event-key-keysym-sym e)
		(cond 
		 ((= keysym SDLK_ESCAPE)
		  (quit-loop #f))
		 ((= keysym SDLK_SPACE)
		  (release (space-of simkeys)))
		 ((= keysym SDLK_LEFT)
		  (release (left-of simkeys)))
		 ((= keysym SDLK_RIGHT)
		  (release (right-of simkeys)))
		 ((= keysym SDLK_UP)
		  (release (up-of simkeys)))
		 ((= keysym SDLK_DOWN)
		  (release (down-of simkeys)))))))
	    (key-event-loop e))))))

(define (main-loop)
  (sdl-fill-rect screen #f bgcolor)
  ;;Player
  (if (pressing-of (left-of simkeys))
      (rotate player 10))
  (if (pressing-of (right-of simkeys))
      (rotate player -10))
  (if (pressing-of (down-of simkeys))
      (accel player))
  (if (pressing-of (up-of simkeys))
      (deccel player))
  (if (pressing-of (space-of simkeys))
      (fire player))
  (set! (fire-interval-of player) (max 0 (- (fire-interval-of player) 1)))
  (inc!-coord (coord-of player) (vvect-of player))
  (wall-warp! (coord-of player))
  (let1 surf (rotate-surface (surface-of player) (angle-of player))
    (let1 trcolor (sdl-map-rgb (sdl-surface-pixel-format surf) 255 10 255)
      (sdl-set-color-key surf SDL_SRCCOLORKEY trcolor))
    (show surf (coord-of player)))
  ;;Enemy
  (let1 broken-enemy-list '()
    (for-each (lambda (ene)
		(let-values (((hit-bullet missed-bullet) (partition! (lambda (bul) 
								       (and
									(eq? (shooter-of bul) shooter-player)
									(close-to? (coord-of bul) (coord-of ene) 20)))
								     bullet-list)))
		  (set! bullet-list missed-bullet)	    
		  (if (null? hit-bullet) 
		      #t
		      (break ene)))
		(if (broken? ene)
		    (set! broken-enemy-list (cons ene broken-enemy-list))
		    (begin
		      (ai ene)
		      (set! (fire-interval-of ene) (max 0 (- (fire-interval-of ene) 1)))
		      (inc!-coord (coord-of ene) (vvect-of ene))
		      (wall-warp! (coord-of ene))
		      (let1 surf (rotate-surface (surface-of ene) (angle-of ene))
			(let1 trcolor (sdl-map-rgb (sdl-surface-pixel-format surf) 255 10 255)
			  (sdl-set-color-key surf SDL_SRCCOLORKEY trcolor))
			(show surf (coord-of ene))))))
	      (filter (lambda (ene) (close-to? (coord-of ene) (coord-of player) 500)) enemy-list))
    (set! enemy-list (lset-difference eq? enemy-list broken-enemy-list)))
  ;;Meteorite
  (let1 broken-meteorite-list '()
    (for-each (lambda (met)
		(let-values (((hit-bullet missed-bullet) (partition! (lambda (bul) (close-to? (coord-of bul) (coord-of met) 20)) bullet-list)))
		  (set! bullet-list missed-bullet)	    
		  (if (null? hit-bullet) 
		      #t
		      (break met)))
	      (if (broken? met)
		  (set! broken-meteorite-list (cons met broken-meteorite-list))
		  (begin
		    (inc!-coord (coord-of met) (vvect-of met))
		    (wall-warp! (coord-of met))
		    (show (surface-of met) (coord-of met)))))
	      (filter (lambda (met) (close-to? (coord-of met) (coord-of player) 500)) meteorite-list))
    (set! meteorite-list (lset-difference eq? meteorite-list broken-meteorite-list)))
  ;;Bullet
  (set! bullet-list (remove! (lambda (bul) (negative? (lifetime-of bul))) bullet-list))
  (for-each (lambda (bul)
	      (inc!-coord (coord-of bul) (vvect-of bul))
	      (dec! (lifetime-of bul))
	      (show (surface-of bul) (coord-of bul)))
	    bullet-list)
  ;;Particle
  (set! particle-list (remove! (lambda (part) (negative? (lifetime-of part))) particle-list))
  (for-each (lambda (part)
	      (inc!-coord (coord-of part) (vvect-of part))
	      (dec! (lifetime-of part))
	      (show (surface-of part) (coord-of part)))
	    particle-list)
  (sdl-flip screen)
  (key-event)
  (sdl-delay 10)
  (main-loop))

(define (run-test)
  (define (surface-load-bmp file)
    (let1 surf (sdl-load-bmp file)
      (if (not (sdl-surface? surf))
	  (display (sdl-get-error)))
      (set! surf (sdl-display-format surf))
      (let1 trcolor (sdl-map-rgb (sdl-surface-pixel-format surf) 255 10 255)
	(sdl-set-color-key surf SDL_SRCCOLORKEY trcolor))
      surf))
  (set! simkeys (make <simkeys>))
  (set! player (make <player> :surface (surface-load-bmp "player.bmp")))
  (make <enemy> :surface (surface-load-bmp "enemy.bmp"))
  (let loop ((i 700))
    (if (= i 0)
	#t
	(begin
	  (let1 ene (make <enemy>)
	    (set!-coord (coord-of ene) (random-coord wall))
	    (set! enemy-list (cons ene enemy-list)))
	  (loop (- i 1)))))
  (make <bullet> :surface (surface-load-bmp "bullet.bmp"))
  (let1 met (make <meteorite>)
    (set! (surface-list-of met) (map surface-load-bmp '("meteorite0.bmp" "meteorite1.bmp" "meteorite2.bmp" "meteorite3.bmp"))))
  (let loop ((i 1000))
    (if (= i 0)
	#t
	(begin 
	  (let1 met (make <meteorite>)
	    (set!-coord (coord-of met) (random-coord wall))
	    (set!-coord (vvect-of met) (random-coord 3))
	    (set! meteorite-list (cons met meteorite-list)))
	  (loop (- i 1)))))
  (make <particle> :surface (surface-load-bmp "particle.bmp"))
  (call/cc (lambda (c)
	     (set! quit-loop c)
	     (main-loop)))
  (sdl-quit))

(run-test)
